#
# my $r = Retriever->new( interval => 5, retry => 3 );
# $r->prepare( GET => "url" );
# $r->prepare( POST => "url", content => "content" );
# $r->retrieve
# $r->retrieve( [HTTP::Request object] )
# $r->extract_select( name => "select_name" );
# $r->extract_table( decode => "utf8", attribs => "table_attribute" )
#

package Retriever;
use strict;
use warnings;
use utf8;
use Encode;
use HTML::Parser;
use LWP::UserAgent;
use HTML::TableExtract;
use List::MoreUtils qw(zip);

sub new {
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;
    my $self = {};
    bless ($self, $class);
    $self->_init(@_);
    return $self;
}

sub _init {
    my $self = shift;
    my %param = @_;
    $self->{_ua} = LWP::UserAgent->new();
    $self->{_ua}->agent( "Mozilla/5.0 (X11; U; Linux x86_64; zh-TW; rv:1.9.2.3) Gecko/20100403 Fedora/3.6.3-4.fc13 Firefox/3.6.3 GTB7.0" );
    $self->{_ua}->default_header(
        'Accept' => "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8",
        'Accept-Language' => "zh-tw,en-us;q=0.7,en;q=0.3",
        'Accept-Charset' => "UTF-8,*",
    );
    $self->{_retry_interval} = $param{interval} || 5;
    $self->{_retry_times} = $param{retry} || 3;
}

sub prepare {
    my $self = shift;
    my %param = @_;
    my $req;
    if (defined $param{POST}){	# 
        $req = HTTP::Request->new(POST => $param{POST});
    } elsif (defined $param{GET}) {
        $req = HTTP::Request->new(GET => $param{GET});
    } else {
        die "url or method not specified";
    }
    $req->content($param{content}) if $param{POST} and $param{content};
    $self->{_req} = $req;
}

sub retrieve {
    my $self = shift;
    $self->{_res} = "";	# clean result
    $self->{_req} = $_[0] if defined $_[0] and ref $_[0] eq "HTTP::Request";
    my $res = $self->{_ua}->request( $self->{_req} );	# response
    my $retry = $self->{_retry_times};	# number of retry times
    RETRY:
    if ($res->is_success){
        $self->{_res} = $res->content;	# get result
    } else {
        print STDERR $res->status_line."\n";
        print STDERR "retry...\n";
        $retry -= 1;
        sleep $self->{_retry_interval};	# retry interval
        goto RETRY if $retry >= 1;
    }
}

sub extract_select {
    my $self = shift;
    my %param = @_;
    my ($in_block, $key);
    $self->{_res_arr} = [];
    my $p = HTML::Parser->new(
        start_h => [sub {
            my ($tag, $attr) = @_;
            if ($tag =~ /^select$/i and $attr->{name} =~ /$param{name}/){
                $in_block = 1;
            } elsif ($in_block and $tag =~ /^option$/i){
                $key = $attr->{value};
            }
        }, "tag, attr"],
        text_h => [sub {
            push @{$self->{_res_arr}}, [$key, $_[0]] if $in_block;
        }, "text"],
        end_h => [sub{
            $in_block = 0 if $_[0] =~ /^\/select$/;
        }, "tag"],
    );
    $p->utf8_mode(1);
    $p->parse($self->{_res});
    return $self->{_res_arr};
}

sub extract_table {
    my $self = shift;
    my %param = @_;
    $self->{_res_arr} = [];
    $self->{_res} = decode($param{decode}, $self->{_res}) if defined $param{decode};
    $self->{_res} =~ s/<br>//ig;
    my $te = HTML::TableExtract->new(%param);
    $te->parse($self->{_res});
    foreach my $ts ($te->tables){
        my $headers;
        my $is_header = 1;
        foreach my $row ($ts->rows){
            my $not_defined = 0;
            for ( my $i = 0; $i <= scalar @$row - 1; $i++ ){
                @$row[$i] = encode("utf8", @$row[$i]) if defined $param{decode};
                if ( ! defined @$row[$i] ){
                    if ( defined @$headers[$i] ){
                        @$row[$i] = @$headers[$i];
                    } else {
                        $not_defined += 1;
                    }
                } else {
                    @$row[$i] =~ s/^\s+//g;
                    @$row[$i] =~ s/\s+$//g;
                }
            }
            if ($is_header){
                $headers = $row;
                $is_header = 0 if $not_defined == 0;
            } else {
                my $dup = 0;
                for ( my $i = 0; $i <= scalar @$row - 1; $i++ ){
                    $dup++ if @$headers[$i] eq @$row[$i];
                }
                push @{$self->{_res_arr}}, {zip @$headers, @$row} if ! $dup;
            }
        }
    }
    return $self->{_res_arr};
}

1;
